home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / MEDICAL / 2608A.ZIP / GP.ZIP / 75LABCRD.SRC < prev    next >
Text File  |  1990-11-03  |  4KB  |  270 lines
  1. ;\|
  2. ;75LABCRD.SRC     Translated from 75LABCRD.EDT by Roger Mathew's EDT2SRC Ver 4.11
  3. ;START    12:13:35 PM  21/ 6/90   |
  4. RECALLSX:
  5. define(Z30|A|30||)
  6. define(YES.NO|A|1||)
  7. define(CHK_FLD|N|8||)
  8. define(NUM_N|N|2||)
  9. define(NUM|A|2||)
  10. define(DATE_A|A|8||)
  11. define(DATE_B|A|10||)
  12. define(TO_DATE|S|8||)
  13. define(WAIT|N|3||)
  14. define(MEM_AD|A|22||)
  15. define(SENT_DATE|S|8||)
  16. define(CHK_DATE|S|8||)
  17. define(PUNC2|N|2||)
  18. define(CH_NAME|A|15||)
  19. define(HIS|A|3||)
  20. define(CLIN_DAY|A|25||)
  21. define(CLIN_TIME|A|10||)
  22. define(CNTR|N|2||)
  23. define(FLAG|A|1||)
  24. define(AMOUNTX|N|4||)
  25. define(S10|A|10||)
  26. define(DATECOD|S|8||)
  27. define(CODER|A|5||)
  28. define(C30|A|30||)
  29. define(TM|A|27||4)
  30. define(A30|A|30||)
  31. define(CHOICE|N|1||)
  32. define(TDND|S|8||)
  33. define(DATERP|S|8||)
  34. define(B30|A|30||)
  35. define(S1|A|1||)
  36. define(TD|S|8||)
  37. define(A8|A|8||)
  38. define(B8|A|8||)
  39. define(YES.NO|A|1||)
  40. define(N5|N|5||)
  41. define(D1|A|1||)
  42. define(NY|A|1||)
  43. define(CODEX1|S|8||)
  44. define(CTR|N|2||)
  45. define(DATEN|N|2||)
  46. define(DATEX|d|10||)
  47. define(ARRAY1|A|30||3)
  48. define(ARRAY2|A|22||3)
  49. define(ARRAY3|A|22||3)
  50. define(ARRAY4|A|4||3)
  51. define(ARRAY5|S|8||3)
  52. define(TIT|A|4||)
  53. define(PATIENT1A|A|30||)
  54. define(PUNC1|N|2||)
  55. define(N.2.0.P|N|2||)
  56. define(P.2.0.1|N|2||)
  57. define(P.2.0.2|N|2||)
  58. define(PATIENT2|A|30||)
  59. define(P.2.0.3|N|2||)
  60. define(RECTYPE1|A|4||)
  61. define(RECTYPE2|A|4||)
  62. define(PATIENT1|A|30||)
  63. define(DOB1|D|10||)
  64. define(DOB2|D|10||)
  65. STARTREC:
  66. open(PATIENT||0|exit)
  67. open(diabetic||0|exit)
  68. open(GPSETUP||0|)
  69. date(TD|G)
  70. trap(q|g|exit)
  71. trap(S|I)
  72. trap(D|I)
  73. trap(F|I)
  74. trap(R|I)
  75. trap(B|I)
  76. trap(G|I)
  77. trap(M|I)
  78. trap(N|I)
  79. LASTSEEN:
  80. mount(LABS|S)
  81. MEM_AD = ("1")
  82. enter(MEM_AD||||Y|N|N|||N)
  83. enter(DOB1||||N|N|N|||N)
  84. enter(DOB2||||N|N|N|||N)
  85. enter(datex||||n|n|n|||n)
  86. SENT_DATE = (TD)
  87. enter(YES.NO|"YN"|||Y|Y|N|||N)
  88. if YES.NO <> ("Y") goto LASTSEEN
  89. gosub RECLABS
  90. ADDRESS1 = (MEM_AD)
  91. find(G|ADDRESS1|EXIT|)
  92. TEST_SEEN:
  93. if DATE.OF.BIRTH < (DOB1) goto NEXT_SEEN
  94. if DATE.OF.BIRTH > (DOB2) goto NEXT_SEEN
  95. diab_ref = (record.number)
  96. find(m|diab_ref|continue|)
  97. if chk_date > (datex) do
  98. {
  99. visit = ("V")
  100. goto not_sent
  101. }
  102. continue:
  103. gosub PRINT_SEEN
  104. VISIT = ("S")
  105. not_sent:
  106. if DATE_SEEN > (SEEN) then SEEN = (DATE_SEEN)
  107. SENT_FOR = (SENT_DATE)
  108. save(PATIENT|N|N)
  109. find(M|ADDRESS1||)
  110. NEXT_SEEN:
  111. find(N|PATIENT|EXIT|)
  112. pmsg(RECORD.NUMBER|1|1|N|N|S|)
  113. goto TEST_SEEN
  114. PRINT_SEEN:
  115. gosub SEXIST
  116. gosub NEWX
  117. gosub SEEN_PRINT
  118. ret
  119. SEEN_PRINT:
  120. WAIT = (WAIT+1)
  121. if WAIT = (195) do
  122. {
  123. pmsg(WAIT;" printed - change cards and press ret..."|10|20|Y|N|S|)
  124. WAIT = (0)
  125. }
  126. pblnk(6)
  127. pfmt(1|||N|N|)
  128. pblnk(2)
  129. pfmt(2|||N|N|)
  130. pblnk(2)
  131. pfmt(3|||N|N|)
  132. pblnk(4)
  133. pfmt(4|||N|N|)
  134. ret
  135. SEXIST:
  136. if SEX = ("M") then TIT = ("Mr.")
  137. if SEX = ("F") do
  138. {
  139. if MARITAL.STATUS = ("M") do
  140. {
  141. TIT = ("Mrs.")
  142. }
  143. else
  144. {
  145. TIT = ("Ms.")
  146. }
  147. }
  148. if SEX = ("") then TIT = ("Ms.")
  149. trim(TIT|T)
  150. ret
  151. NEWX:
  152. NY = (" ")
  153. PATIENT1A = (PATIENT.NAME)
  154. trim(PATIENT1A|T)
  155. PUNC1 =loc(","|PATIENT1A|1||27)
  156. N.2.0.P =siz(A|PATIENT.NAME)
  157. P.2.0.1 = (PUNC1-1)
  158. PATIENT2 =mid(PATIENT.NAME|1|P.2.0.1|)
  159. P.2.0.2 = (PUNC1+2)
  160. P.2.0.3 = (N.2.0.P-P.2.0.2+1)
  161. PATIENT1 =mid(PATIENT1A|P.2.0.2|P.2.0.3|)
  162. trim(PATIENT1|T)
  163. trim(PATIENT2|T)
  164. Z30 = (TIT+PATIENT1+NY+PATIENT2)
  165. ret
  166. EXIT:
  167. run("recmenu")
  168. EXIT1:
  169. run("recmenu")
  170. PRINTSTOP:
  171. pon(S)
  172. clrlne(1|25)
  173. pmsg("CONTINUE ? (Y/N):"|30|12|N|N|S|)
  174. enter(YES.NO|"YN"||PRINTSTOP|Y|Y|N|48|12|N)
  175. if YES.NO <> ("Y") then run("recmenu")
  176. pon(P)
  177. ret
  178. reclabs:
  179. trap(p|d|)
  180. pchr(p|4)
  181. mount(new|r|p|)
  182. pset(50|18|18)
  183. ret
  184. \STLABS    
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.                      PRINTS ADDRESSES ON CARDS FOR 75 VISIT
  192.                    ┌───────────────────────────────────────┐
  193.                    │ From Address:&                        │
  194.                    │ From Dob    :&          eg 01/01/1880 │
  195.                    │ To Dob      :&          eg 01/04/1914 │
  196.                    │ Year Start  :&          eg 01/04/1990 │
  197.                    │     CONTINUE:&                        │
  198.                    └───────────────────────────────────────┘
  199.                      REQUIRES CARDS IN PRINTER REVERSE SIDE
  200.                           Esc - Exit or stop printing
  201.  
  202.  
  203.  
  204.  
  205.  
  206.  
  207.  
  208.  
  209. \
  210. MEM_AD
  211. DOB1
  212. DOB2
  213. DATEX
  214. YES.NO
  215. \
  216. \R NEW     
  217.         &
  218.            &
  219.                &
  220. -
  221.  
  222.  
  223.  
  224.  
  225.  
  226.  
  227.  
  228.  
  229.  
  230.  
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  
  258.  
  259.  
  260.  
  261.  
  262.  
  263.  
  264.  
  265. \
  266. Z30
  267. ADDRESS1
  268. AREA
  269. \
  270.